﻿

namespace FML

#light


#if INTERACTIVE
#I @"C:\Program Files\Reference Assemblies\Microsoft\F#\1.0\Runtime\v2.0"
#I @"C:\Windows\Microsoft.NET\Framework\v2.0.50727"
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.5"

#r "mscorlib.dll"
#r "System.dll"
#r "System.Core.dll"
#r "C:\Users\jcm\Documents\projects\Monads\libs\FsCheck.dll"
#r "C:\Users\jcm\Documents\projects\Monads\libs\NunitCore.dll"
#r "C:\Users\jcm\Documents\projects\Monads\Monads\obj\Debug\Monads.dll"
#endif


 module ContMTest =

 
  printf "Monad test\n\n"

  open Microsoft.FSharp.Control
  open Microsoft.FSharp.Control.LazyExtensions
  open FsCheck

  open ContM

  let (>>=) m f = contM.Bind (m, f)
  let ret = contM.Return

  
  quickCheck (fun a f k -> let m = contM.Return(a)
                           let g a = contM.Return (f a)
                           run (m >>= g) k =  run (g a) k)

  quickCheck (fun a k -> let m = contM.Return(a)
                         run  (m >>= ret) k =  run m k)

  quickCheck (fun a ff fg k ->  let m = contM.Return(a)
                                let f a = contM.Return(ff a)
                                let g a = contM.Return(fg a)
                                run ((m >>= f) >>= g) k =  run (m >>= (fun x -> f x >>= g)) k)

  quickCheck (fun a b f -> let r = contM { let a' = a
                                           let b' = b 
                                           return (f a b)
                                         }
                           run r id = f a b)
                          
  quickCheck (fun a f k -> let m = contM.Return(a)
                           run (fmap f m) k = k (f a))


  quickCheck (fun a b f -> let r = contM { let a' = contM.Return(a) 
                                           let b' = contM.Return(b) 
                                           return (f a b)
                                         }
                           run r id = (f a b))
                                          
  quickCheck (fun a b   -> let k = callCC (fun k -> contM {let a' = contM.Return(a)
                                                           do! k b
                                                           return! a'
                                                          })
                           (run k id) = b)
 
  // are tail calls preserved? -> no stack overflow

  let rec count l = match l with
                    |[] -> contM {return 0} 
                    |_::t -> contM { let! c = count t
                                     return (c+1)
                                   }

  let c = run (count (List.init 5000000 id)) id
  printf "count = %A\n" c

 module IdentityMTest = 

  open  Microsoft.FSharp.Control
  open  Microsoft.FSharp.Control.LazyExtensions
  open FsCheck

  open FML.IdentityM

  let (>>=) m f = identityM.Bind (m, f)
  let ret = identityM.Return
  let fmap f m = identityM.Map(f, m)
  let join m = identityM.Join(m)

 
  quickCheck (fun  f a -> ((ret a) >>= f) = f a)
  quickCheck (fun m  -> (m >>= ret) = m)
  quickCheck (fun m f g-> ((m >>= f) >>= g) = (m >>= (fun x -> f x >>= g)))

  quickCheck (fun f a -> fmap f a = f a)
  quickCheck (fun a -> join a = a)


 module OptionMTest =

  open  Microsoft.FSharp.Control
  open  Microsoft.FSharp.Control.LazyExtensions
  open FsCheck

  open FML.OptionM

  let (>>=) m f = optionM.Bind (m, f)
  let ret = optionM.Return
  let fmap f m = optionM.Map(f, m)
  let join m = optionM.Join(m)
 
  quickCheck (fun  f a -> ((ret a) >>= f) = f a)
  quickCheck (fun m  -> (m >>= ret) = m)
  quickCheck (fun m f g-> ((m >>= f) >>= g) = (m >>= (fun x -> f x >>= g)))

  quickCheck (fun f a -> let pred   =  match a with
                                       |None -> None
                                       |Some x -> Some (f x)
                         fmap f a = pred)
                               
  quickCheck (fun a -> join a = match a with 
                                |Some x -> x
                                |None -> None) 

                                
  quickCheck (fun f a b -> let r = optionM { let! a' = a
                                             let! b' = b
                                             return  (f a b)
                                           }
                           r = match (a,b) with
                               |None, _ -> None
                               |_, None -> None 
                               |_, _ ->  Some (f a b) )

  let rec f n     = optionM { if n = 0 then return 0
                                       else return! (f (n-1))
                            }
  let r = f 10


 module ListMTest =

  open  Microsoft.FSharp.Control
  open  Microsoft.FSharp.Control.LazyExtensions
  open FsCheck

  open FML.ListM

  let (>>=) m f = listM.Bind (m, f)
  let ret = listM.Return
  let fmap f m = listM.Map(f, m)
  let join m = listM.Join(m)

  quickCheck (fun  f a -> ((ret a) >>= f) = f a)
  quickCheck (fun m  -> (m >>= ret) = m)
  quickCheck (fun m f g-> ((m >>= f) >>= g) = (m >>= (fun x -> f x >>= g)))

  quickCheck (fun f a -> fmap f a = List.map f a)
  quickCheck (fun f a -> join a = List.concat  a)

  let rec f l = listM { let! a = l
                        return a
                      }

  let r = f (Seq.toList (seq { for i in 1 .. 100000 -> i}))


 
 module StateMTest =

  open  Microsoft.FSharp.Control
  open  Microsoft.FSharp.Control.LazyExtensions
  open FsCheck

  open FML.StateM

  let (>>=) m f = stateM.Bind (m, f)
  let ret = stateM.Return
  let fmap f m = stateM.Map(f, m)
  let join m = stateM.Join(m)

  quickCheck (fun f a s-> run ((ret a) >>= f) s = run (f a) s)
  quickCheck (fun m s -> run (m >>= ret) s = run m s)
  quickCheck (fun m f g s ->run  ((m >>= f) >>= g) s = run (m >>= (fun x -> f x >>= g)) s)

  quickCheck (fun s ->fst (run get s) = s)
 
  quickCheck (fun (s:int) a  -> let r = stateM { return! get }
                                run r s = (s,s) )

  quickCheck (fun f s     a  -> let r = stateM { let x = a
                                                 let y = f a
                                                 return y
                                               }
                                run r s = (f a, s))
 
  quickCheck (fun s ->let r = stateM { do! set s
                                       return! get
                                     }
                      run r () = (s,s))

  quickCheck (fun f a s ->let r = stateM { do! modify f 
                                           return a
                                         }
                          fst (run r s) = a && snd (run r s) = f s)

  quickCheck (fun f m s ->let (x, s') =  (run m s)
                          run (fmap f m) s =  (f x, s')
              )
                         
  quickCheck (fun f m s ->let (x, s') =  (run m s)
                          run (mapState f m) s = f (x, s'))
             
  quickCheck (fun f m s -> run (withState f m) s = run m (f s))
 
  quickCheck (fun m s1 s2 -> let (x, s') = run m s1 
                             let (x', s'') = run x s'
                             run (join m) s1 = (x', s''))
            
  
 module WriterMTest =

  open  Microsoft.FSharp.Control
  open  Microsoft.FSharp.Control.LazyExtensions
  open FsCheck

  open FML.WriterM
  open FML.Monoid
 

  let monoid = new ListMonoid<int>() :> Monoid<int list>

  let writerM = WriterBuilder(monoid) :> IWriterMonad<int list>

 
  let (>>=) m f = writerM.Bind (m, f)
  let ret = writerM.Return
  
  quickCheck (fun f a -> run ((ret a) >>= f)  = run (f a) )
  quickCheck (fun m  -> run (m >>= ret)  = run m )
  quickCheck (fun m f g  ->run  ((m >>= f) >>= g) = run (m >>= (fun x -> f x >>= g)) )

  quickCheck (fun a b v ->  let m =    writerM { do!  tell a
                                                 do!  tell b
                                                 return v
                                               }
                            run m = (v, monoid.Append a b))

  quickCheck (fun a v ->  let m = writerM { do!  tell a
                                            return v
                                          }
                          run (listen m) = ((v,a), a))

  quickCheck (fun a f v ->  let m = writerM { do!  tell a
                                              return (v, f)
                                            }
                            run (pass m) = (v, f a))

  quickCheck (fun m f ->  run (mapWriter f m) = f (run m))

  quickCheck (fun m f ->  let (x, s') = run m
                          run (fmap f m) = (f x, s'))

  quickCheck (fun a f ->  run (write a) = ((), a))

 
 module ReaderMTest =

  open  Microsoft.FSharp.Control
  open  Microsoft.FSharp.Control.LazyExtensions
  open FsCheck

  open FML.ReaderM

  let (>>=) m f = readerM.Bind (m, f)
  let ret = readerM.Return
  let asks f = readerM.Asks(f)
 
  quickCheck (fun f a s-> run ((ret a) >>= f) s = run (f a) s)
  quickCheck (fun m s -> run (m >>= ret) s = run m s)
  quickCheck (fun m f g s ->run  ((m >>= f) >>= g) s = run (m >>= (fun x -> f x >>= g)) s)

  quickCheck (fun s -> run (ask) s = s)
  quickCheck (fun s -> run (ask) s = s)
  quickCheck (fun f s m -> run (local f m) s = (run m ) (f s))
  quickCheck (fun f s m -> run (withReader f m) s = (run m ) (f s))
  quickCheck (fun f s m -> run (fmap f m) s = f (run m s))
  quickCheck (fun f s m -> run (mapReader f m) s = f (run m s))
  quickCheck (fun f s  -> run (asks f ) s = f s)


 
 module ErrorMTest =

  open  Microsoft.FSharp.Control
  open  Microsoft.FSharp.Control.LazyExtensions
  open FsCheck

  open FML.ErrorM

  let (>>=) m f = errorM.Bind (m, f)
  let ret = errorM.Return
  let fmap f m = errorM.Map(f, m)
 
  quickCheck (fun f a ->  ((ret a) >>= f) =  (f a) )
  quickCheck (fun m  ->  (m >>= ret) =  m )
  quickCheck (fun m f g  ->  ((m >>= f) >>= g)  =  (m >>= (fun x -> f x >>= g)) )

  quickCheck (fun m f -> let r = match m with 
                                 |Right x -> Right <| f x
                                 |Left x -> m
                         r =  (fmap f m)) 

  quickCheck (fun a b  ->   let m = errorM { let! a' = Right a
                                             let! b' = Right b
                                             return (a'+b')
                                           }
                            m = Right (a+b) )

  quickCheck (fun a b  ->   let m = errorM { let! a' = Right a
                                             let! b' = Left b
                                             return (a'+b')
                                           }
                            m = Left b )

  quickCheck (fun a b  ->   let m = errorM { let! a' = Left a
                                             let! b' = Right b
                                             return (a'+b')
                                           }
                            m = Left a )

  quickCheck (fun a b  ->   let m = errorM { let! a' = Left a
                                             let! b' = Left b
                                             return (a'+b')
                                           }
                            m = Left a )
                              
  quickCheck (fun a  -> throwError a = Left a )

  quickCheck (fun f m  -> let r = match m with
                                  |Right _ -> m
                                  |Left x -> f x 
                          r = catch m f)
                              
